perm filename PCALL.SAI[PNT,HE]17 blob
sn#646157 filedate 1982-03-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00003 00003 ! swap to E, then resume
C00006 00004 ! readcode
C00011 00005 ! editcall,renamecall
C00021 00006 ! readcall,renmcall,writecall,photocall,helpcall
C00024 00007 ! display: update,arrow,displaycall,redisplaycall,showcall,nodisplaycall
C00030 00008 ! graphcall
C00031 00009 ! eeditcall
C00032 00010 ! deletecall,definecall,notavailcall,exitcall
C00041 00011 ! dimencall
C00044 00012 ! requirecall,baidcall,setstatuscall,readmesscall,stopmesscall
C00048 00013 ! savecorecall
C00051ENDMK
C⊗;
ENTRY;
BEGIN "PCALL"
COMMENT routines which are not available in AL;
DEFINE $PCALL=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
! swap to E, then resume ;
PROCEDURE ESWAP(REFERENCE STRING MODIFY_STRING);
BEGIN
! this procedure will save the current state of the POINTY program in
the file XXXXXX.DMP[PNT,HE], and swap to E to a file called E$TEMP.TMP[PNT,HE]
which it writes with the contents of MODIFY_STRING,
and allows the user to modify. When the user exits E
by doing <control>XRUN, the POINTY program resumes by swapping back
XXXXXX.DMP[PNT,HE] and renaming it POINTY, and then reading in E$TEMP.TMP[PNT,HE]
as the input string MODIFY_STRING;
INTEGER ARRAY EARRAY[0:'17];
INTEGER ARRAY SAVADR[0:4],GETADR[0:5];
STRING COREIMAGEFILE,E$TEMP;
E$TEMP←"E$TEMP.TMP[PNT,HE]";
WRITEFILE(E$TEMP,MODIFY_STRING);
COREIMAGEFILE←"XXXXXX.DMP[PNT,HE]";
SAVADR[0]←CVSIX("DSK");
SAVADR[1]←CVFIL(COREIMAGEFILE,SAVADR[2],SAVADR[4]);
GETADR[0]←CVSIX("SYS");
GETADR[1]←CVFIL("E.DMP[1,3]",GETADR[2],GETADR[4]);
GETADR[3]←1;
GETADR[5]←CALL(0,"DSKPPN"); ! use current dsk ppn;
ARRCLR(EARRAY);
EARRAY[0]←CVFIL(COREIMAGEFILE,EARRAY[1],EARRAY[3]);
EARRAY[6]←CVSIX("DSK");
EARRAY['14]←CVFIL(E$TEMP,EARRAY['13],EARRAY['11]);
EARRAY['12]←CVSIX("DSK");
EARRAY['13]←EARRAY['13] LOR '100000; ! /N mode ;
EARRAY['15]←1; ! line no = 1;
EARRAY['16]←1; ! page no = 1;
EARRAY['17]←(LOCATION(SAVADR[0]) LSH 18) LOR LOCATION(GETADR[0]);
BRK_N;
PRINT("I am swapping to the Editor; when you are done with the Editor, type
<control>XRUN to resume. If you get out of E by typing <control>E, get
back into E by typing CONT and resume by typing <control>XRUN.
If you lose your core image, you can resume by doing a RU "&COREIMAGEFILE&"
");
SWAP0(SAVADR,GETADR,EARRAY);
DELFILE(COREIMAGEFILE);
MODIFY_STRING←READFILE(E$TEMP);
DELFILE(E$TEMP);
END;
! readcode;
INTERNAL PROCEDURE READCODE(STRING FID; BOOLEAN ECHO(FALSE));
BEGIN
PUSHDEVSTACK;
$INPCH←OREADFILE(FID,$EOF);
IFC #DISPL THENC $ALLOW←$ALLOW+1; IF ECHO THEN DPYFREE; ENDC
DEVICE←DSK_X;
NEWFILE←TRUE; FILEPRINT←ECHO;
END;
! editcall,renamecall;
RPTR(SYMBOL) $VAR; ! sticky argument for EDITCALL;
RPTR(EXPR$) $VAREXPR≠
INTERNAL PROCEDURE EDITCALL;
BAGIN
BOOLEAN DEFAULT;
GTOKEN(FALSE); ! in case he left out the argument ;
DEFAULT←FALSE;
IF FINAL THEN DEFAULT←TRUE
ELSE IF TOKENPTR=JULL_RECORD THEN ERROR("Unknown identifier")
ELSE $VAR←TOKENPTR;
IF $VAR=NULL_RECORD THEN ERROR("Need argument since no argumeft so far");
IF SYMBOL:TYPE[$VAR]=#MC
THEN BEGIN
INTEGER BRCHAR;
STRING OLD_STRING,NEW_STRING,LINE_STRING;
OLD_STRING← "REDEFINE "&MACRO:HEAD[SYMBOL:OBJECT[$VAR]]
&" = "&CVSYM($VAR,EDIT_D)&";";
NEW_STRING←LINE_STRING←NULL;
WHILE OLD_STRING DO
BEGIN LINE_STRING←SCAN(OLD_STRING,$CRTAB,BRCHAR);
LODED(LINE_STRING&CR);
NEW_STRING←NEW_STRING&INCHWL&CRLF;
END;
ASKUSER(";"&NEW_STRING);
END
ELSE
BEGIN
RPTR(EXPR$)E; RPTR(SYMBOL)S;INTEGER TYPE; STRING ST;
IF (TYPE←SYMBOL:TYPE[$VAR])=#PR OR (TYPE=#EV) OR (TYPE=#CM)
THEN ERROR("Cant edit "&$DTYPE[TYPE]&" yet")
ELSE IF PRDECL($VAR)
THEN ERROR(SYMBOL:PNAME[$VAR]&" is a POINTY defined variable or constant and cannot be changed")
ELSE IF SYMBOL:ACCESS[$VAR]=#ARRAY
THEN ERROR("Cant edit array elements yet");
IF NOT DEFAULT THEN
BEGIN STOKEN←TRUE; $VAREXPR←IDREF(S); $VAR←S; END;
SEMICOL_READ; ! leave there to avoid troubles;
PPRINT("value of "&SYMBOL:PNAME[$VAR]&" = ");
ST←CVSYM($VAR,EDIT_D);
FPRINT(CRLF&"{old value was "&ST&"}"&CRLF&" ");
LODED(ST&CR);
ASKUSER;
ASGEX2($VAR,$VAREXPR);
END;
END;
INTERNAL PROCEDURE RENAMCALL;
BEGIN
STRING NEW; RPTR(SYMBOL) TPTR;
GTOKEN;
IF #TOKEN≠UNDECLARED_TYPE THEN ERROR("RENAME: Need undeclared token");
NAW←TOKEN;
WORD_READ("←")3
GTOKEN3
IF #TOKEN≠ID_TYPE OR SYMBOL:ACCESS[TPTR←TOKENPTR]≠#SIMPLE THEN ERROR
("RENAME: cAn only change names of simple variables currently");
! SEMICOL_READ; ! commented out dkr cleaning;
SYMBOL:PNAME@7Q!)%;⎇≥β.v$BAGQ¬]OKf↓iQJA9C[JA%\AeK
←eHAMs[E←0r~∀∪% A'35¬∨_uQ3! 7Q!)%:tG
$@4∀∩@@↓)⊃ ≤A
%β5
u!≥¬≠ 7'e≠¬∨_i∨¬∃
)7)!Q%;;?9 .v~(∪ ≥λl~∀_B@∪IKCIG¬YXYe∃][GC1XYoe%iKGC1XYaQ=i←GC1XYQK1aGCY0v~∀~)∪
ε@
∨+)!PA)⊃ 9ε~∀∩4∃∪≥)∃%≥β_↓!%∨π∃ +%
↓% β
β→_Q ∨∨→ ¬≤A π!≡Q)%U
RRv4∀∪¬ ≥∪≤~∀%')%∪9∞A
∪1
v@@@@@@@@@~(∪
∪→∃>E
→β$]¬_Dv∩$∩∩BA⊃KMCk1hAmC1kJv~(∪∂)∨- ≤Q
¬→'
Rl~∀∪∪_A≥∨(↓
∪≥β0~∀∩@A)⊃ 8A¬ ∂%≤~∀∩%')∨↔∃≥?)%U
w
∪1 ?≥β5
1∨ a
∪→
l~∀@∩%' ≠∪
∨_1%∃βλv∩$BAG←5[K]i∃HA←kPAErA5YNv~(∩∪')=↔ ≥?Q%+
v4∀∩∪ 9λv~∀@@@@@A% ¬ π∨ ∀Q
∪→∀Y π⊃<Rv~∀% ≥λv4∀~∃∪9) %≥¬_A!%=π +I
A/%%)πβ→0v~∀∪ ∂∪≤EαD~(∪')%%≥∞A
%→
v~(∪∪≥)∃∂ $A9 → ≠∃≥)&Y$v~∀∪I!)$QM3≠¬∨0Sβ%%¬2A →∃≠ ≥)M6btlQ:v~∀4∀∪≥ 1 ≠ ≥Q'>`v4∀∪
∪1 >Iβ1
_v∩$∩BAI∃MCkYPAmCYUKfv~(∪∂)∨- ≤Q
¬→'
Rl~∀∪∪_A≥∨(↓
∪≥β0@~∀∩@A)⊃∃_AπβM
@G)=↔ ≤A= ~∀∩$∧∩~∀$∪7% L1)3!∃:~∀∩$∪∪ A∃#*Q)=↔ ≤X ∪≥)≡λRA)⊃∃_A')=↔ ≥?Q%+
~(∩∩∩@↓ ⊃'
↓∪ @ ∃#*Q)=↔ ≤X β→_D THEN ERROR("Can't use "&TOKEN&
" as argument to be saved in a write statement");
[ID_TYPE]
DO α
IF (NELEMENTS←NELEMENTS+1)>64 THEN ERROR("Cant output more than 64 elements in one statement");
ELEMENTS[NELEMENTS]←TOKENPTR;
GTOKEN(FALSE);
IF TOKEN="," THEN GTOKEN
ELSE IF FINAL THEN DONE
ELSE STOKEN←TRUE;
β UNTIL #TOKEN≠ID_TYPE;
ELSE ERROR("Can't write out the value of "&TOKEN)
β;
GTOKEN(FALSE);
IF NOT FINAL
THEN IF ¬EQU(TOKEN,"INTO") THEN
ERROR("Need INTO here before putting in file name, but you have got "&token)
ELSE FILE←NAME_OF_FILE;
WARRCODE(FILE,ELEMENTS,NELEMENTS);
END "A";
ENDC
INTERNAL PROCEDURE PHOTOCALL(STRING FILE);
BEGIN
! SEMICOL_READ; ! commented out for cleaning;
IFC #OUTPT THENC TTYSAVE(FILE); ENDC ! file status modified;
$OULST←NULL;
END;
INTERNAL PROCEDURE HELPCALL;
IF $CLINR≠NULL THEN BEGIN GTOKEN3 HELP(TOKEN) END ELSE HELP;
! diqplay: update,arrow,displaycall,redisplAycall,shoWcall,nodiSplaicall;
λIFC ¬ #ARROW TH@ ≥ε4⊃∪≥)∃%≥β_↓'∪≠!1
A!¬=β +I
Aβ%I_∞MmβX4*⊗t" 4*L2¬↓∞$JNB⊃¬""ε:_h($*LrR⊗≡-⊃α6∩M~B2εKY↓¬β&KGC3∂Iβ7?&)l4*$*~&:*↓αRε∀b∀b∩M~B2εKiA04PJRfB)B∩&N∧bεeu
`4(&≥J6
>aB∩&N∧bεeu∩`4(εtxbαε≥α2εek→l4(hRN&6∧b∃↓α≥"J&::αBJ>≤*∩VJ*α∩,h~Te#1Q M∀ZJU∀r∧$α$Ss⊃λ91 Pj)⊃IHD∧ISsλIpRIH:S⊃J'⊃"C"J*∃∀J
;30Q(L"$iU∀P"$Th" lF&$ij∞FEεE∩dεTEGER DDISPLAY;
BMODEAN FDISPDAY;
PRLππ U%αA A3 →~!'!%∪9∞A&Rl~∀∪'
%∨→_ ~∀DF BFFF BFFF BFFF BFFF BFFF A' →∃π ∩⊗"αRεJL
2⊗~↓¬
~→
~→¬
~→
~→¬
~→
∩`4*M`h)
~→¬
~→¬
~→¬
~→
~→¬
~→¬
~→
~→
~→
~→¬
~→
~→¬
~→
~→
~→
`h) )α⊃%l4Ph*BJ|~⊗∩V∀)α∩Bβ~d
∩ →e$,xZ"¬4~*EM∧U↔0hP~85∀|IEhR∧!"RR%%"RR%%"RR%%"RR%%"RR%$∧≥
*(Te"∧$b$%K~∧-]h~%%Mλ[R2∃4¬"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"R∩⊃Q%[
Irβ;KUB$$~:∧d
→I∃≥%:h∃∃%~λUj`Q$"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"∩`Q$"Rα%↔0hPQ*¬∀|8XE-∀TλE¬M;→U≠XQ($,<→d¬≥%)→d:¬51PPM*
E∩E;→T∀|E~5Lk1Q M∃
J"E≥→Z$,→ I∃≥"~;∀cXQ!∃≥LKxDM≥ H∃IDI~5#XQ!∃,$~J5Lm5λDM≥ H∃IDI~5"K1Q M≥yjTdc1Q M< →D*¬;→A\uYIAE∀X9u∀ Q!⊂L$tλ$,<→aPPH~;u~4:j5≥LU
5Lm(X1Dd~:CU¬J+5≥LKU∩4≥)HcXh!⊃∃≥LKz5Lm(X1Dd~:CTt[
E]≥→KSXh!⊃∀,tG1PPLJ ∀,dU
2KXQ(Tt#1Q hT→jD-∀h→B¬¬)x4,%Z(R¬-λH∃$+1Q LLd∧D dIzskα
I∧,r∧JU∧$~HT%|h→E≤+1Q hP∀∀π/εL≡F*πM Rε&≡>εf∂∀¬εN2∧H∀ddzwSαK1Q$LuHZ$t D
¬∀|8XE-∀T
$,tZw0hP_(T<Ld ∀u$XxU∩∧↔1PPJJZ∧$
HXE⎇%*XSXh!_4
≤T T$M: D
J x`hP∀∧αα∧(XtLpQ!∩αα∧ 5$ )HQD$~:∧d
≠QPPH_(T<LaQ HLJ ∀%∀~w0hP⊃_d⎇∩ ≠r≥≤5D55"D:E∩b:*Bb≤j$∧$z
XD
%h~"DJ↔1PPH_iu∩∧≠t5≤~D:e"b:J"b≥*EB≤5$λDzαHI∃≥∧H≠∀dM:K4MmxJ¬IE:J$Ltu ∩KXQ!⊂LLh4α≤⎇ZJ¬"¬IλTt~ _b∧tzDα$⎇YJ5"¬IλTrαIzTe≥KxdLdS
5%∀→hs\,hH0hP⊃∀D$4J:E|$Xh∃,eG1PPH→zU$% ↔0hP∀↓∀%¬→zU"C∃↔0hP⊃_Tt#1Q Jα∧∧¬\tsλDM≥ H∃MhQ!⊂LLd d$M: D
J
I∧,pQ!⊂L∀Xy∀ph!⊃∩∧⎇ZHE¬:↓Q"∩R%%"RR%%"RR%%"RR%%"RR%%"RR%$¬α∧t ∩∧r
D¬Jα%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"Ph(I∃≥∧H≠∩¬≥Z
¬∀-:8T#Z
K∃∧*∧∧¬∀,I~5∧d≠∀α¬$tλt-"λ(∀≤ZλI∃≥∧H≠∩¬$_)D(h*K∃∧*∧λDM≥ H∃J¬88∀d
*4α¬$tλDM≥ H∃J¬88∀d
*1PRR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RR%%"RPQ$"bk5ES∩K4 d$M: D
Mxh∀e≤W1PPH_Yd#XQ!∩αα∧ 5%MλS∧$M: D
MQQ HL(XtLr
XD
%h~"E$I~5∧d≠∃∪Xh!⊃∩$$~:∧d
→I∃≥%:HDM≥ H∃MmxJ¬IE:J$Ltu
D$M: D
J↔1PPH_J¬M4~%¬$$~:∧d
∃↔0hP⊃_Tt#1Q Jα∧∧¬]≥→X$|aλI∃≥∧H≠∃hh!⊃∀%¬~;∀m_Q!∩αα∧λTt#1Q Jα∧∧∧-≤3
βXh!_Tt#1Q$,tH1PPh)_d~α8I∃≥∧D
DD,h1PPh)→e$-)h∀b¬
)t≤,JZ$*¬(XDM≥ H∃L≤→ICXh!_$,<→aPRλ~8TlL9yAE∀X_CXH∀∀ε≡}]\Vw&\Dε␈/D f␈∩ =F.∞m≥f;XQ!∩$ IIu={π1PPMHI∃≥∧H≠∃{β1Q LlI~5∧d≠≠u$ )HQD$~:∧d
↔1PPLI~5∧d≠∪∧dM:Ktu,IC¬∀,9z$#XQ!∀,tG1PPh)→e$-)h∀b¬
)t≤,JZ$*∧ixDM≥ H∃L≤→ICXh!_$,<→aPPJ∀
5-¬
(U≥~λI∃≥∧H≠∪Xh$⊃∃≤,Y_4|A
(T #1⊃∩
ε=⎇Vn.nLV"ε}↑Bε6}$ε≡f\≥fNvw1PPLhI∃≥∧H≠∃⎇%*XSXh!→T$M: D
MyiqD$~:∧d
↔1PPLI~5∧d≠∪∧dM:Ktu,IC¬∀,9z$#XQ!∀,TG1PPh)→e$-)h∀b¬
)t≤,JZ$*∧I~5∧d≠_4 dG1PPL(XtLpQ!∀LuHXt-∩
JCXh!_u$|8YcXh!_d⎇∩
JEz≤Y→b¬≥HZαβ
λYe$LD∧4l
∧λDxh!∀αα∧_d∧-
U
D|\YeB$%K~∧-]JKRJ∧z$∧-
U
Dl\YeB$%K~∧-]JKR2∃4%∩¬$λYb∧$yhSXh!→∀2¬JCB≤l≠∧¬$DYd¬$$~:∧d
≠zE h!∀αα∧YJ4*∧Z*$⎇∩∧)fzπ>\6BεL≡F
πO≡ε+R∧$e$|8Yb4≥)HbKXQ!∩
ε≤LBπ& Tπε␈>=⊗⊗NM≡GJε|dε∂≡=≥f:βNO↔ε+d
¬∀|8XE-∀W1PPLzIt\,eλd e8U∪Xh!→∀2∧izB∧4→h∀bQ!⊂M$λYb∧Ld¬∧-
U
Dl\YeB∃¬)x4,%Z(R∩J z"∧-~U¬$|8Ybb∃
)t≤,JZ$-~%∃⊂hP⊃⊃∀ tD∧4lLcJD$M: D
ID8$
≤_3¬%MλZ0hP⊃⊃∩αα
I∧,r
HDM≥ H∃M⎇HI∃≥∧H≠∩Z≤X≠hP⊃∀αα∧YJ4*∧Z*$⎇∩∧)vvg∀
GOε\@ππ⊗|<V'/,↑2ε␈$ &∂≡≤4ε&∂L∀π'O Z2ε∞<8Wπ&\@"KXQ!∀l$~:∧d
≠zEM∧SλDM≥ H∃KXQ!∀,TG1PPh)→e$-)h∀b¬
)t ,JZ$*¬9 u,≤→ICXh!_$,<→aPPM*
E∩E9→U∀,3 DM≥E~4c
J9C∪XQ!∃≤C≠z4c∃yhU9E(X4⎇∀E
5Lm(X1Dd~:BKXQ!∀$zλ(T<LaQ Jα∧∧∧=$y8TsXQ!∩αα∧ ∀2¬Iy4,u
J#l@U3∪β
Q0sj(β"B!~⊂⊃3Dλ4TSj%λTr znH∪L\9λ_$
88|Muλ≤≤M|y9≥.,(≠|D∞X<Z,≤[→(
l;9( ≤]→<D
r∪ud%.c"A∀λλλ
;34Q(∪∪∩4jGSQ6
Kts K[ts KyQ1f
(0stHE∀r3*(0f∪ ~u
.aQB(λ∧∧∀v3*(0f∪ ~u∞T
JVpsε+7u∪i83T∃
'c"B$∧λλ⊃jIrq3EλP3∀hU.c"A∀λλλ _H∃∪i83FhEDH⊂3HD∪Su∧λR3P)D∃∩⊃)D⊃4TIzJλSL\9λ_$ {{;,∀≥≠h∞<<_<L≡→(_.,⎇;9-n≤hJ'1"B(∧∧⊃3Q∧
3U∩)D⊃R3H→∞c"A→1∩4j ⊂67j;30SiC⊃∩4j ⊂6.aQB1∩*:∪⊂6# ∩4u zv34HXf∪∩*:∞SQ+
⊗tsε≠.c"A_3Q∞aQQ3Qλ1"C"AQ@↓D"9|L≡~_x-M∞c"I_Phλhx5∩⊃*$∃∩⊃)hc"R)j⊃4SH→λ∀∀Ixq1∃*((⊃tH~∩⊂p)I∞c"H(1r3AQB21DλtP4
JO3U)Iε∀Q(9tQλ
I⊃3HλZTStE∧QtP* ∞H≠Mt→_= ∀_⎇<N,;]≠∂∀_=X-≥_8[ TJ.c!!0TRc Nc"A_tP4 ¬⊃tP* ∀Q0g(⊂5⊂+8tP4
JW+β!!""1j(4∩∀HXnPu HR5∀k8tP4
JW+β!!""1j(4∩∀HXnST j∀vqj(4∃∀KUβ"B!⊃1tP* ∀Q0g*r6Q+8tP4
JW*.aQB1tH~∃∀Wij3∪ε
(0stHGc"Q)h∞c"AQR3UλZSP3∧
∀SphX∃4Q$
⊃tP* ⊂p3 Gc"B((1r3AQB5⊃+λ0nc!!1tP* ⊂p3 Gc"B(YQ∞c!(3Q⊂aQ@↓D"99,M=_x-M∞c"I→U⊃4Ih3λ∀
)pq1
ZQ(⊃(X∩5⊂h→∪∞c!!0Q1i→C"B**∃∀J
;30SiE13∞i→U⊃1hZH∪pJK4⊃.j:∀R3Ht⊃PShK.c"A~T∃∀E
pp3λ~K∃Q(:∪tK
JP3TeHTP3(U∀Su¬I00tIu(∃⊃)Z∞c"A~u∀R)hh∃P*'c"C!!5P4Ky1⊃F
(01∞d↓"Hα*8320iyε∀Q(_∞hλ∧∧α""!QB13 ys⊃∀k→*∃P*%∪pU ~⊃*.a⊃""($∞X<H
↑<⎇λ ←~<⎇∧
;H →5⊂0G1"B5λY4↔tk→0Ssπ)pRQ(:⊗q3 Wc"C!!21H xU⊗4λT∂(λiXc"B$∧λ∃∩λYH⊂Q(y3C"A⊃23UλXq4Hλ*Pr⊂*'c"B!~u∀R)hh∪sλC∀u∀I→Qnc!!"3sλC∀u∀I→Qwh∧*Q1⊃(i3Q(∧$S00j)nR⊃(_⊗tv)XSs∞IxRQ0jKq3↔+Q"B"!∀HH∂$∧IPuJ;3*⊃)E⊃1∩*C⊃
)D'hNc!!"14jx4
∪iHε∀u
)3Qj'1"B"(~ru4hZJ∪sλC∀u∀I→Qj.aQB"1)hβ"B$∧λ⊃3
8(⊃4J)tJλHX1∩5π$≠{[∂∀≥X;
≤λ→[n$≠88n-|hJ'1"B1)h∞c"@↓D"9→-L=→8l≥≠ → \Z;Y,<;≠
m⎇_=L≥;_x-M →>
≡_x;
GRNAL PROCEDURE DELETECALL(BOOLEAN QUIETλFALSE));
BEGIN
STRING VAR;
GTOKEN(FALSE);
IF FINAL OR EQU(TOKEN,"ALL")
THEN IF QUIETOR EQU(TOKEN,"ALL") THEN RESET
ELSE BEGIN ! deletes all the varaables;
STRING ANSWER;
PRINT("are you sure adl variables are to be deleted? ");
ANSWER←INCHRW;
PRINT(CRLF);ESC_P;
IF ANSWER="Q"MR ANSWER≥ y"
THEN RESET
ELSE EBRMR("instructioN ngtexec@UiKHD$r~∀∩% ⊂~⊂hP%↓↓∧*2N∃∧∩⊗≡εp↓ ∪↔d∧W&* X ]9;]∞∀@εE∧Bi(")
))j PeTiiT*)≥FB∧Ddg∃"cbiλ⊃bf"SV ]Pλbf"fWX≥FEαDij'Rbg/j∀*b]@ SSPTR←NEG_RSTACK;
DO BEGIN A"
GTOKEN0⊗~(∩∩@@A∪ AQ∨↔ ≥A)$A)! ≤~∀$∩∪¬ ≥∪≤
∀$∩∩@@@BAG!KGVA%HACYIKCIr↓←\Ai!JAYSMh@v~(∩∩∩@@A¬∨=→ β≤↓
∨+≥⊂v~∀∩$∩@@@↓∪ A!I π_!)∨↔ 9!)$R↓)⊃ ≤↓ %%∨HPE 1 !
t↓iesS9NAi↑↓IKYKQJABAA∨∪≥)dAIKG1CeKH↓mCeS¬EYJ@λM)∨↔∃≤Rv~(∩∩∩@@A
∨U≥ ?
¬→'
v4∀∩∩∩@@A
=$A∪>DA') @@bA,rR&1α~⊗2⊗jα∩<4PH$$&L1αJN$
∞-j≥"ε∞.]~NBR∃jn&um">.⊗uαRIα$B⊗84PH$$$L∩⊗≡&rα~>Vt"}RJ,)mα∩|r∃mα,r⊃l4PH$%↓α↓α&→∧r>Qα4zV:⊃¬""⊗8hP$$$L∩⊗≡&ph($$HI∞⊗2,j⎇∞⊗d*5-EXh($$HJJBV≤A"NN¬"I2R|Z⊗:B%⊃%l4PH$$&,r⊃l4PH$&⊗t 4($J↓↓↓α,bN∃αL1α:>"αFV&-!αR",qα⊗J∀zI!
$*2⊗R+QβW;↑s?←9π#?/↔r↓ →α$z.⊗9KX4($J↓↓↓α="0≤\Ye∧4 J8RKXQ!⊂Jα∧∧∧L2
It\,c4"b∩λ→d"∧izB∧4→h∀b¬IλTb∧Z*$m∩∧'2ε␈$¬Bπ⊗↑≡VO⊗\@"KXQ!⊂Jα∧∧∧,TD∧$
⊂Q!⊂M,jI∀b∧i→d c1Q HLiz"∧Mv∀¬≥$Z∧β
¬YjDLB∧8Td,TλDxh!⊃∩αα∧ 4Ldβ∃P*%∀Tuλ_rnTjH0rvj:t∃∀K[r7*'⊃"B"(YQλλLL;→= T→;⊃-\;]≤d'c"B(YQ∞c!!"C"J
Spq(J4Q(λHαc$g⊃acb"J!'gf⊃`g⊂)⊃b"c∀NFE⊂⊂λ!"cdS⊂)(*∀∀"`aT'TP&Pah ∀R9 SDRIJG MACNAME; INTEGER DDLCMP ≥(lA')%%≥εA¬= 2Y≥ ∨ 2v4∀∩BAIKIKL↓SfAiIkBASα1β'Q∧KE⬬∪↔∪↔6K;'SN{9l4PJ&:R,:⊗IαuαεJεhb:>8D"⊗~ε,bPbε∀:Mmα∀z>"⊗ qα∩⊗4
V2Pβ
∧
∀→S0hPQ!∀e∧~(∀m{π0∧$ h~Te!
λ∃∀ [xd E8W2∧=Iy4,sαc"A→1H∀HX⊃1H
I⊃3C!! 0Q(y3Hλ$ z→0mP4s⊂~z⊂0v≤2pr<H2|4y]9]FEαDdc⊂∃'ebg∀*)≡g∃f&∧)⊃agi"λ'i⊂)Vfa'f∞*,h"Vh'ebS(*).FQfaFB∧DDj∩ g⊂"T)'i∀λ)"b"Q$g"]λ⊃∪*'Rbg∪⊃λ4yP7≠z⊂0P≠pqy7H70vrH∀YFEαDf`aT*)/iVfa'f∞'a%"Ph-j'Rbg(*∀.]FEαDbg"βEbf∀bP$cλ⊃j'eQg⊂
P∃g""aS i"bε*,h"CE∧Dj∩ g⊂"T)'i∀λ&`ai∪P""c∩g$j$Sg≥⊂ .eed undec@1CeKH↓SIK]QSMCKH@R
∀$∪ →'∀A≠βπA)%?≥∃*C%
∨%λQ5βπ%≡$v~∀∪⊃ →π∨U≥(A>`v~∀%≠βπ≥¬≠
A>↓)∨↔ 8v~∀∪≥)∨π 8v~∀~(∪∪ AQ∨↔ ≤l@PD~(∩@@AQ⊃β≤A ∂β≤↓')∨↔∃≥0≡R∃*∃mαl
∞J=TB⊗ε∩\jε∞B%∩v}6 ~0∀ XW2∧,hAPPJ∧∧∧,E8QPPJ∧∧α∧∀Xy∀bα. ↔⊗∞\ZF/⊗\Dεn∞>-r⊂H!⊃∃∀≤H~5~¬ I∃≥"λ:E∀Lht¬∧
(→Rd$Xh∃,e@ε∃H→∞h∀J
∀J∀ I4u
$ Q6∃
¬.c"A∀λλλ↓~T∃∀E
∪∩4jE(∃⊃)Z ∃⊃)Z ∞c!!"5⊃)Z ↔sJY∪ε∀HXstQπ1"B"(Ihλ⊂HXr3H∧,y=λ∞ <X;,↑→<\d!"B"$∧λλ⊃jIrq3G1"B"$∧λλ∩(dλu∪i83Hεd
3Q⊃(9⊂4Q(C∃⊗4λT∃∩⊃)dβ"B!⊃10TIzJλS(_tShλH1R3I~⊂3sG$≠Y9,D≥;Y \{_<L\λ≥≠m<;H→M}H_<L};9;NDJ.c!!"(λ∧∧∪T⊂*(37sJλ4P3%6.c"A⊃(λλ∧
⊃34 yQ5h*(0stHE∀∪∩*:
.c!!"(λ∧∧∀∪∩*:∞SQ+
∀⊗uλY4↔7jH34 π1"B"$∧λλ∀ I4u∞Jλ4P3+:⊃34 [u∪rhYNc"A⊃(λλ∧
⊃34ε u⊃3*πc"B!∀λλλλz∪rq)gc"B!∀λλλ _H∃∪i83O(E∧H∃∩λYC"B!⊃0Q1i→HλY \X=;∞D_<Yn]9;]∧!"B"!→3U⊃(x4H⊃λ9u3U¬J⊂su)j ∩.d
u∀R)hh⊃⊂*(nc"A⊃"1⊃(h53∃β
⊂4P)[u∀U(Wc"B!⊃1⊂sjYU↔lπ4∀⊂sjYU↔l'4⊃⊂4H{hJλG1"B"!_∪h⊂HXr3C!!""(∧∧λ∩7j(01∃ →∪
λE¬$λJ'1"B"!∀λλλλH4QwhH4QiJIrq3Di.c"A⊃"(λ∧∧∩1H ↔(DλD
∩⊃3AQB""!_Q1r)d⊃⊂sjYU↔l'1"B"!⊃(λλ∧λ∪h⊂HXr3H ≠tQ0(J∩3∪¬∧D∧(E↔c"B!⊃""1λ~Qwqλ~QiU yq3II↔c"B!⊃""2(d∩/(B∧H∃∩λYH⊃⊂iz3U↔hHsu3JEl(⊃)Jq(⊃λ9u3U x⊂su)j ,.aQB""!⊃13Q∧
3U∩)D⊃⊂sjYU∂,π1"B"!⊃13Q↓QB""$∧λλ⊃)Jq(∩(d∩/(E∧H∃∩λYH∀⊂iz3U↔jλsu3JEl#"A⊃""1)Jq(∀λ9u3U z⊂su)j ,.aQB""$∧λλ⊃)hλ∃3JI3λ∀λ9u3UπV∞c"A⊃"4∪ ~u∞QλXP53
C∃P3 :⊃34 [q⊂4Hwc"B!⊃5stHFF∀Q(_
λK∧%λJ(E↔c"B!⊃13Q∧∧Y→9L≡;≥λ ≡Y⎇;,]]λC!!"(λ∧∧⊃3∀hT∩1HλH1P5)Jε∀⊂*(3(∃ λ3H⊃**StJ∧)Y99∧ →9X.]≥λ≤ ≡X;9.L<H∩ ↑Y(J!QB"(∧∧λ⊃3
8(∩1D
∪rq)chKλDλ3Qλ
Irq3C4J(H
I⊃3HλZTStE∧SY9,D λ≠n$
(∩ ↑Y(J!Q@""$∧⊃3∀hT⊂π'gε""c Uf*_ARGSONON_DEFAULT_ARGS+1;
END "get parameters" UNTIL TOKEN=")"3
BEGIN
INTEGER I; STRING ARRAY S,D[1:NPARAM]9
STRING HEAD; HEAD←") ;
FOR I←NPARAM STEP -1 UNTIL 1 DO
BEGAN
HEAD←","&(S[I]←PLIST~PARAM[P ≠A:RL~(∩∩α∩! 7∪;⎇!→∪'Pu∩⊗4
V"Pβ
d e:HTm¬U∀dD01εaQ@""*H34↔j ∩4uπ)Q2∃
u⊃3* ,¬FEαD@bg⊃≥FE∧BfbfgT,mf'P`j$gS∀)TnEdbfgT,if'P`j$gS∀
ACRO:PRLIST[MAC@TR])];
∩∪5 ≠∨%e7→∨π¬)∪∨≤αB⊃&T<j⊗&>∃Jn2≡≤
R&>p¬∧l 8∧Sgλα"c Ud*_ARG[MACPTR])]3
MACRO:HEAD[MACPTR]←IACNAH
LλPDM⊃∃β 6dααR=ui`_h!⊃∀,@Q∞c!↓ ∧f`Pi']'∀ i fVd¬ACPTR]@?9!β%β4v~∀∩@@A 9λ@EAα Cπ\X
↑Y9⊂≠pqy7H≥FE∧UhπORD_READ("=" ∧ DRlA↓ →
≠ ⊗: α⎇↓EXh(&
|"f⎇λα⊃l4(Hh(&∩zα
,y→`hPα"2)j⊃1q*$∩.c!↓ ∧doT ¬ADTIH 1@∧!↓
%↔0hP⊃_$|%≠x$|%∀jDl\Y`dKXQ!⊂LLd ∪j⊃∧!PPH∀∧α¬$λYb∧∧IH4m3Q t⊃⊃∪λ9βjg*λ∃P⊂FB∧@P⊂λ"f)bH "&!Sh¬ND← DDLAH∂+≥P@Z@BβX4(∀∧α∧,h@λ
YU∩3∧λ⊃∪⊂i@h¬ND≥0;
λ BODY←BODY[2 TLε@≤ZE:v~∀%∪ A≥Aβ%β~βqAαRD*0⊂@ B0HXp∧gεB∧g!'Q,kg*S&≥FEαk`$f⊃P!'b⊗P"'FB∧@a"Qdg⊂⊃≤97qr\βs the parameteps"
INTEGER I;
INDEGER BRCHAR9 SDRIJG TTOKEN;
L¬¬∨ e?≥¬∨⊃2M'π¬_Q¬∨⊃2XI→Q)β∧Y %π⊃βHRv~∀$∪))∨- ≥ >≤~ε9"∀z∩e1$r2RR ⊃2
J≤BεI%Xh($&4zIα&{ αNR-↓↓EααYe$LD e∧
(→PhP⊃∀αααλIpLLdλU
* X∀≥∀w*¬∀d~:E\L_:¬%∃Xεr+U∃∃∪i83J(
I⊃3HλIsQ.aQB"2(d∩/SJλ4P3$
∩⊃3AQ@"")@!'b,Wg!'b⊗S**'RbgεEαDDbf∀bP'!∪b,og⊂'b,S⊃*fflF "f$SS**'Rbg∪"∃fflL⊃"f$fNFE∧DQg"⊂⊃≤97qr\yP:4→P80y_vrz2\9Q≥FB∧bg"λ"f)bH'!'b⊗oa'b⊗]FE∧S`aa'N!'b,Vf`ah∃).`∨NBODY;
! SEMICOL_READ; ! commefted out for cleaning;
IF NOT REDEF THEN ENSYM(MACNAME, #IC, MACPTR);
! enter into symbol table id a Define ;
$MCLST←NULL;
END;
IJTERNAL PROCEDURE DEFINECALL(BOOLEAN BEDAF(FALSE));
BEGIN
DO BEGIN
↓ DEFINECKDE(REDEF);
GTOKEN(FALSE);
END UNTIL TOKEN≠",";
STOKEN←TRUE;
END;
INTERNAL PROCEDURE NOTAVAILCALL;
BEGIN
PRINT(TOKEN & " &#VERSION);
OUTSTR("Will flush this statement"&crlf);
DO GTMKEN(FALSE) UNTIL FINAL;
END;
IJTERNAL PROCEDURE EXITCALL;
ENDIT;
! dimencall;
INTERNAL PROCEDURE DIMENCALL;
BEGIN "dimencall"
STRING DIMEN_NAME;
RPTR(DIMENS) D1;
forward recursive rptr(dimens) procedure factor;
recursive rptr(dimens) proceDure term+
α rptr(dimefs) r1,r2;
r1←FACTOR;
IF R⊃=JULL_RECORD THEN ERROR( S]mC1SHAKaaeKgMS←\\λRv~∀$∪/⊃∪1
A)∨- ≤jD(@A∨$↓)∨↔ 8zD↑D↓ ≡~∀$∩∩∧~(∩∩∪'Q%∪≥∞↓&vA'⎇)∨↔ 8v~∀∩$∪∂)∨- ≤f~(∩∩∪$I?
βπQ∨$v~(∩∩∪∪_A&zD(@A)⊃∃≤A$c⎇≠+→(a ∪≠ 9&Q$b1$dR~(∩∩∩∪∃→'
AHc? ∪Y∪
1⊃∪≠ ≥LQ$bYHdRv~(∩∩∩εl~∀∩∪I !+¬8Q$bRl~∀∩@@@εv4∀~∀∪IKGkeMSmJAIaidQ⊃S[K]LSae←
KIke∀AMCGQ←dv~(∩∧AeAidQI%[C]f%dbYdHrA%!Q$Q'∪5¬∨_SLbv~∀$∪∪ AQ∨↔ ≤t@ ! ¬""⊗9h($$H⊃αIF⎇"⊗J5 β
ELSE IF TOKEN = "INV" THEN
α GTOKEN; IF TOKEN≠"(" THEN ERROR("need open paren after INV")
ELSE R2←TERM;
R1←DIVIDE_DIMENS(NIL_DIMENS,R2);
β
ELSE IF (S1←CHECK(TOKEN,#DM))=NULL_RECORD
THEN ERROR(TOKEN & "not declared.")
ELSE BEGIN R1←SYMBOL:OBJECT[S1]; GTOKEN; END;
RETURN(R1);
β;
GTOKEN;
IF #TOKEN≠UNDECLARED_TYPE OR CHECK(TOKEN,#DM)≠NULL_RECORD
THEN ERROR("Can only use unreserved ID's for dimensions.");
DIMEN_NAME←TOKEN;
WORD_READ("=");
GTOKEN;
D1←TERM;
IF D1=NULL_RECORD OR CHECK_DIMENS(D1,NIL_DIMENS)
THEN D1←NULL_RECORD;
DIMENS:SYM[D1]←ENSYM(DIMEN_NAME,#DM,D1);
STOKEN←TRUE;
END "dimencall";
! requirecall,bailcall,setstatuscall,readmesscall,stopmesscall;
INTERNAL PROCEDURE REQUIRECALL;
BEGIN
GTOKEN;
IF EQU(TOKEN,"SOURCE_FILE") THEN READCALL(FILEPRINT)
ELSE IF EQU(TOKEN,"ERROR_MODES")
THEN BEGIN INTEGER L; STRING S; INTEGER I;BOOLEAN T;
S←STR_READ; L←LENGTH(S); T←TRUE;
FOR I←1 STEP 1 UNTIL L DO
IF S[I FOR 1]="-" THEN T←FALSE
ELSE IF S[I FOR 1]="F" THEN NON_STRICT_DIMENSIONAL_CHECKING←T
ELSE T←TRUE;
END
ELSE IF EQU(TOKEN,"COMPILER_SWITCHES")
THEN STR_READ
ELSE IF EQU(TOKEN,"BAIL") THEN BAILCALL
ELSE IF EQU(TOKEN,"QBAIL") THEN QBLCALL
ELSE IF EQU(TOKEN,"MESSAGE") THEN PRINT(STR_READ)
ELSE ERROR(TOKEN&" is invalid for REQUIRE");
END;
INTERNAL PROCEDURE BAILCALL;
BAILCODE;
INTERNAL PROCEDURE QBLCALL;
QBAILCODE;
INTERNAL PROCEDURE SETSTATUSCALL(INTEGER VARVALUE);
BEGIN
! this procedure is to set the values of certain POINTY system variables
in the SAIL part for program control : it takes a VARIABLE and an integer
and assigns the value of the string to the variable name ;
INTEGER I; STRING VARNAME,PRNAME;
WORD_READ("(");
GTOKEN;
VARNAME←TOKEN;
IF VARVALUE=1 THEN PRNAME←"SETSTATUS:" ELSE PRNAME←"RESETSTATUS:";
GTOKEN;
IF TOKEN=","
THEN BEGIN
GTOKEN;
IF #TOKEN≠INT_TYPE THEN ERROR(PRNAME&" Need integer argument");
VARVALUE←INTSCAN(TOKEN,I);
END
ELSE STOKEN←TRUE;
IF EQU(VARNAME,"PPCODE") THEN !PPCODE←VARVALUE
ELSE IF EQU(VARNAME,"LINE") THEN !LINE←VARVALUE
ELSE IF EQU(VARNAME,"PWCODE") THEN !PWCODE←VARVALUE
ELSE IF EQU(VARNAME,"NOFOLD") THEN !NOFOLD←VARVALUE
ELSE IF EQU(VARNAME,"ALPRIN") THEN !ALPRIN←VARVALUE
ELSE IF EQU(VARNAME,"PRTIME") THEN !PRTIME←VARVALUE
ELSE IF EQU(VARNAME,"DEBUG") THEN !DEBUG←VARVALUE
ELSE IF EQU(VARNAME,"NOELF") THEN
BEGIN $NOELF←VARVALUE;
IF $ELFUNAVAILABLE THEN ERROR("This is no good. I cant get access to the ELF!!!");
END
ELSE ERROR(PRNAME&" valid arguments are PPCODE,PWCODE,LINE,NOELF,NOFOLD,ALPRIN,PRTIME,DEBUG");
WORD_READ(")");
END;
INTERNAL PROCEDURE READMESSCALL;
BEGIN
PUSHDEVSTACK;
DEVICE←MESSAGE_X;
END;
INTERNAL PROCEDURE STOPMESSCALL;
BEGIN
$CLNE←$CLINR←NULL;
POPDEVSTACK;
END;
! savecorecall;
STRING RSUME_STRING;
PROCEDURE RESUME0;
RSUME_STRING←NULL;
REQUIRE RESUME0 INITIALIZATION;
INTERNAL PROCEDURE RSUMEMESSCALL;
BEGIN
WORD_READ("(");
RSUME_STRING←STR_READ;
WORD_READ(")");
END;
INTERNAL PROCEDURE SAVECORECALL(STRING FILE);
BEGIN
BOOLEAN SAMECOREIMAGE; INTEGER I;
BOOLEAN SIMULATION;
INTEGER ARRAY SAVADR[0:4],GETADR[0:5],ACCUM[0:'17];
IF $NOELF OR $ELFUNAVAILABLE THEN
BEGIN SIMULATION[TRUE;
PRINT("ELF unavailable, only sav@%]NA!⊃ Zb`↓aCehα⊃%l4PH&⊗: h(&⊗e~∃αNLjV2ε$J6:}4
2N∃Xh(4(M~εZε%∩mBv|~ZN&BA
∩NZ⊃%l4PJNεZ "JmFmz∞Z~La"~&d)2Nε4
∩Jm∃i2Nε4
∩Jm%i%l4PJ&→α≤
Zε∩∃YFuv≥2N&aB∩B>&u"e %¬""⊗9∧*JJ>∩A
Nε4*∞ =(W"ε&⎇nBπ/<Tε'.↑ fNfT
∧|LjK∩∩K1Q LLd
4
4_J%[∃S855≤≠¬α∀$Z∧"J¬IλTph!⊃∀∀,y→b¬¬)→e"D:)D2b)∀π>NMDε>OlTε/GL]g≡N⎇dε}2¬hDmα%↔0hP⊃~4
4_J%[∃[x55≤≠¬α∀$Z∧"KXQ!⊂L,hG0hP_~%∀≤J%∧<-H_E∩K1Q L
*(4e∩λ_4≥,U↔0hP__4≥,[4s =[u∧d|8~DL|e
4
4_J%[¬U∀∧e≤∧ε∪BK1Q LDYJ↓D,hG0hPQ!∀L2 iu"¬9→U,d~I∀|r
I∧,pQ!⊂L∀Xy∀ph!⊃∀LuHXt-∩λ~%∀
∀λTd4XYU[ $vSββεεα{"6≠SXh!⊃∃≤
f⊗∩D,HiT,j↔1PPH~8∀l,9z$,LX_t-⎇:x∃βα
8∃4 J%D<-H_E∩d_85,j↔1PPH→_b∧tzD¬≤ XX4⎇∀Y→T <T
DD,aQ HH_(T<LaQ HH~(U≠ ∃λTd4XYRKX∀∀ε}vO∀π⊗/>Mw⊗*
≤bπ↔]dε7⊗⎇Tε&O=4βXh!⊃⊂LLi~CβXQ!⊂HM
)∀u"
*5,lS
5%∀→hrKXQ!⊂HLYhCXh!⊃∃∀-:J%# ∃∧s β⊗E∪Xh!⊃∀,tAQ L,J8PL∀Xy∀ph!⊃∃≤ XX4⎇∀Y→T <[z5<
嬬≤
h_E∩dxZD %%H∀≤≥YU∪Xh!⊃∀L2 iu"¬8→T,≤z(TLl_xR¬$λY`hP⊃⊃∀∀,y→b∧Li~CβXQ!⊂HM
)∀u"
*5,lS
5%∀→hr4≥)H`hP⊃⊃⊂J2*=⊗o.L≡FN}d
vvg∃Dεvz∞ Gαk⊗∀ε≡␈,TεNn≤|R∩K1Q HH_Yd#XQ!⊂L,hG0hP_Yd#XQ!PT,hDα∃∧8→Db∪1Q